# -*- mode: Perl -*-
# /=====================================================================\ #
# |  xcolor.sty                                                         | #
# | Implementation for LaTeXML                                          | #
# |=====================================================================| #
# | Part of LaTeXML:                                                    | #
# |  Public domain software, produced as part of work done by the       | #
# |  United States Government & not subject to copyright in the US.     | #
# |---------------------------------------------------------------------| #
# | Thanks to Silviu Vlad Oprea <s.oprea@jacobs-university.de>          | #
# | of the arXMLiv group for initial implementation                     | #
# |    http://arxmliv.kwarc.info/                                       | #
# | Released under the Gnu Public License                               | #
# | Released to the Public Domain                                       | #
# |---------------------------------------------------------------------| #
# | Bruce Miller <bruce.miller@nist.gov>                        #_#     | #
# | http://dlmf.nist.gov/LaTeXML/                              (o o)    | #
# \=========================================================ooo==U==ooo=/ #
package LaTeXML::Package::Pool;
use strict;
use warnings;
use LaTeXML::Package;
use List::Util qw(min max);

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Options & Initializations.
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

DefConditional('\ifglobalcolors',   undef);
DefConditional('\ifdefinecolors',   undef);
DefConditional('\ifconvertcolorsD', undef);
DefConditional('\ifconvertcolorsU', undef);
DefConditional('\ifblendcolors',    undef);
DefConditional('\ifmaskcolors',     undef);
DefConditional('\ifxglobal@',       undef);
RawTeX('\globalcolorsfalse\definecolorstrue');

RequirePackage('color');

# Setting target color model (ignored for now)
foreach my $option (qw(natural rgb cmy cmyk hsb gray RGB HTML HSB Gray monochrome)) {    #mono???
  DeclareOption($option, sub { }); }

# Ignorable options
foreach my $option (qw(showerrors hideerrors fixpdftex prologue
  kernelfbox xcdraw noxcdraw fixinclude
  dviwindo oztex xdvi
  usenames)) {    # which does... what?
  DeclareOption($option, sub { }); }

# Loading sets of names
DeclareOption('dvipsnames',  sub { InputDefinitions('dvipsnam', type => 'def'); return; });
DeclareOption('dvipsnames*', sub { InputDefinitions('dvipsnam', type => 'def'); return; });
DeclareOption('svgnames',    sub { InputDefinitions('svgnam',   type => 'def'); return; });
DeclareOption('svgnames*',   sub { InputDefinitions('svgnam',   type => 'def'); return; });
DeclareOption('x11names',    sub { InputDefinitions('x11nam',   type => 'def'); return; });
DeclareOption('x11names*',   sub { InputDefinitions('x11nam',   type => 'def'); return; });

# Load colortbl package;
DeclareOption('table', sub { RequirePackage('colortbl'); return; });

# Does this load hyperref, or modify it? - TODO??
DeclareOption('hyperref', sub { });

DefMacro('\GetGinDriver', '');
DefMacro('\GinDriver',    'LaTeXML');

DefRegister('\tracingcolors' => Number(0));
DefMacro('\XC@tracing', '0');

# Start with "current color" (using the shorthand ".") to black
AssignValue('color_.' => Black());

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Extra Color Models
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
sub delta {
  my ($v, $n) = @_;
  return ($v <= ($n + 1) / 2 ? $v / ($n + 1) : ($v + 1) / ($n + 1)); }

#======================================================================
# RGB: red,green,blue integers in 0..L, L = 255 by default
DefMacroI('\rangeRGB', undef, '255');

DefColorModel('RGB', 'rgb',
  sub {    # RGB ==> rgb
    my $L = ToString(Expand(T_CS '\rangeRGB'));
    Color('rgb', map { delta($_, $L) } $_[0]->components); },
  sub {    # rgb ==> RGB
    my $L = ToString(Expand(T_CS '\rangeRGB'));
    Color('RGB', map { int($_ * $L + 0.5) } $_[0]->components); });

#======================================================================
# HTML = RRGGBB where RR,GG,BB are red,green,blue components in hex
DefColorModel('HTML', 'rgb',
  sub {    # HTML ==> rgb
    if ($_[0][1] =~ m/(..)(..)(..)/) {
      Color('rgb', map { delta(hex($_), 255) } $1, $2, $3); } },
  sub {
    my $hex = $_[0]->toHex; $hex =~ s/^#//;
    Color('HTML', $hex); });
#======================================================================
# Hsb: h in 0..H, s,b in 0..1,  H = 360 by default
DefMacroI('\rangeHsb', undef, '360');

DefColorModel('Hsb', 'hsb',
  sub {    # Hsb ==> hsb
    my $H = ToString(Expand(T_CS '\rangeHsb'));
    Color('hsb', $_[0][1] / $H, $_[0][2], $_[0][3]); },
  sub {    # hsb ==> Hsb
    my $H = ToString(Expand(T_CS '\rangeHsb'));
    Color('Hsb', $H * $_[0][1], $_[0][2], $_[0][3]); });

#======================================================================
# HSB: h,s,b in 0..M,  M = 240 by default
DefMacroI('\rangeHSB', undef, '240');

DefColorModel('HSB', 'hsb',
  sub {    # HSB ==> hsb
    my $M = ToString(Expand(T_CS '\rangeHSB'));
    Color('hsb', delta($_[0][1], $M), delta($_[0][2], $M), delta($_[0][3], $M)); },
  sub {    # hsb ==> HSB
    my $M = ToString(Expand(T_CS '\rangeHSB'));
    Color('HSB', map { int(0.5 + $M * $_) } $_[0][1], $_[0][2], $_[0][3]); });

#======================================================================
# "tuned" or Piecewise continuous Hsb
# \rangetHsb is sequence of pairs x,y (; x,y)*
DefMacroI('\rangetHsb', undef, '60,30;120,60;180,120;210,180;240,240');

DefColorModel('tHsb', 'hsb',
  sub {    # tHsb ==> hsb
    my ($model, $h, $s, $b) = @{ $_[0] };
    my $H = ToString(Expand(T_CS '\rangeHsb'));
    #  my $rangetHsb = '0,0;'.ToString(Expand T_CS '\rangetHsb').';'.$H.','.$H;
    my $rangetHsb = ToString(Expand T_CS '\rangetHsb') . ';' . $H . ',' . $H;
    my ($xn, $yn, $xn_1, $yn_1) = (0, 0, 0, 0);
    foreach (split(';', $rangetHsb)) {
      ($xn_1, $yn_1) = ($xn, $yn);
      ($xn,   $yn)   = split(',', $_);
      last if $h <= $xn; }
    Color('hsb', ($yn_1 + (($yn - $yn_1) / ($xn - $xn_1)) * ($h - $xn_1)) / $H, $s, $b); },
  sub {    # hsb ==> tHsb
    my ($model, $h, $s, $b) = @{ $_[0] };
    # First scale Hue.
    my $H = ToString(Expand(T_CS '\rangeHsb'));
    $h *= $H;
    my $rangetHsb = ToString(Expand T_CS '\rangetHsb') . ';' . $H . ',' . $H;
    my ($xn, $yn, $xn_1, $yn_1) = (0, 0, 0, 0);
    foreach (split(';', $rangetHsb)) {
      ($xn_1, $yn_1) = ($xn, $yn);
      ($xn,   $yn)   = split(',', $_);
      #     last if $h >= $yn_1 && $h <= $yn; }
      last if $h <= $yn; }
    Color('tHsb', $xn_1 + (($xn - $xn_1) / ($yn - $yn_1)) * ($h - $yn_1), $s, $b); });
#======================================================================

DefMacroI('\rangeGray', undef, '15');
DefColorModel('Gray', 'gray',
  sub {    # Gray ==> gray
    my $N = ToString(Expand(T_CS '\rangeGray'));
    Color('gray', delta($_[0][1], $N)); },
  sub {    # gray ==> Gray
    my $N = ToString(Expand(T_CS '\rangeGray'));
    Color('Gray', int(0.5 + $N * $_[0][1])); });

#======================================================================
DefColorModel('wave', 'hsb',
  sub {    # wave ==> hsb
    my ($model, $lambda) = @{ $_[0] };
    my $g = 1;    # fixed correction number; xcolor uses 1; pstricks uses others (e.g. 0.8).
                  # anyway, no significant difference can be notified.
    local *eta = sub {
      my ($x) = @_;
      min(1, max(0, $x))**$g; };
    my ($h, $bb);
    if    ($lambda < 440) { $h = 4 + eta(($lambda - 440) / (-60)); }
    elsif ($lambda < 490) { $h = 4 - eta(($lambda - 440) / 50); }
    elsif ($lambda < 510) { $h = 2 + eta(($lambda - 510) / (-20)); }
    elsif ($lambda < 580) { $h = 2 - eta(($lambda - 510) / 70); }
    elsif ($lambda < 645) { $h = eta(($lambda - 645) / (-65)); }
    else                  { $h = 0; }
    if    ($lambda < 420) { $bb = eta(0.3 + 0.7 * ($lambda - 380) / 40); }
    elsif ($lambda < 700) { $bb = 1; }
    else                  { $bb = eta(0.3 + 0.7 * ($lambda - 780) / (-80)); }
    Color('hsb', $h / 6, 1, $bb); },
  sub {
    Error(); });

#======================================================================

DefMacro('\adjustUCRBG',  '1,1,1,1');    # ??
DefMacro('\paperquality', '1');

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Specifying colors
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Decoding colors etc.
# Several kinds of target forms of color.
# We COULD assume HTML model (the rest of latexml sorta does) "#RRGGBB"
# OR we could assume rgb, ('rgb',r,g,b)
# OR we could assume converted to any core model: (model,components,...)
###our $TARGET_COLOR_MODEL = 'rgb';
our $TARGET_COLOR_MODEL = '';

# ParseXColor(<model_list>,<spec_list_or_color_expr>, <tomodel>);
#  If <model_list> is non-empty, then treat it as a list of models (separated by '/')
#     choose the current target model, or the 1st model if none match the current one
#     then find the corresponding spec in <spec_list> (also separated by '/')
#     if<model_list> was prefixed with <model>:, convert result to that model.
#  Otherwise,
#     treat <spec_list_or_color_expr> as a color expression.
#     evaluate it.
# if <tomodel> is non-null,
#   convert the final result to that model
sub ParseXColor {
  my ($models, $specs, $tomodel) = @_;
  $models  = ToString($models)  if ref $models;
  $specs   = ToString($specs)   if ref $specs;
  $tomodel = ToString($tomodel) if ref $tomodel;
  my $color;
  if ($models) {    # If models given, it's in form: (tomodel:)? model (,model)*
    if ($models =~ s/^(.*?)://) {
      $tomodel = $1 unless $tomodel; }
    my @models = split(/\//, $models);
    my @specs  = split(/\//, $specs);
    if (scalar(@models) != scalar(@specs)) {
      Error('unexpected', $specs, $STATE->getStomach,
        "Length of color model_list must be same as spec_list.",
        "models is '$models'; specs is '$specs'");
      return Black(); }
    my ($model, $spec) = ($models[0], $specs[0]);
    while (@models) {
      if ($models[0] eq $TARGET_COLOR_MODEL) {
        ($model, $spec) = ($models[0], $specs[0]); last; }
      shift(@models); shift(@specs); }
    # Now, parse the spec relative to the chosen model
    $spec =~ s/^\s+//; $spec =~ s/\s+$//;
    if ($spec =~ /^\{\s*(.*?)\s*\}$/) {    # Trim
      $spec = $1; }
    if ($model eq 'named') {
      $color = LookupColor($spec); }
    else {
      $color = Color($model, ($spec =~ /,/ ? split(/\s*,\s*/, $spec) : split(/\s+/, $spec)))->toCore; } }
  else {
    $color = DecodeColor($specs); }
  # And finally convert to the target model, if requested.
  return ($tomodel ? $color->convert($tomodel) : $color); }

#======================================================================
# Given a <colorexpr>
#  (<name>|<expression>|<extended_expression>) <functional_expression>*
# decode it into ($model,@spec) form

# NOTE: Clean up this code....
sub DecodeColor {
  my ($expression) = @_;
  $expression = ToString($expression);
  my $prefix_re      = qr/-/;    #
                                 # [ <name> = . ==> current color; <name> = '' ==> white]
  my $name_re        = qr/|[-]*\.|[-]*[a-zA-Z0-9@\*_]+|[a-zA-Z0-9@\*\-_]+/;
  my $ne_name_re     = qr/[-]*\.|[-]*[a-zA-Z0-9@\*_]+|[a-zA-Z0-9@\*\-_]+/;
  my $pct_re         = qr/(?:\d*\.?\d*|[+-]*\d+\.?\d*|[+-]*\d*\.?\d+)/;
  my $pct_capture_re = qr/(\d*\.?\d*|[+-]*\d+\.?\d*|[+-]*\d*\.?\d+)/;
  # <mix_expr>     : !<pct1>!<name1>!...<pctn>!(<namen>)?
  my $mix_expr_re = qr/!\s*$pct_re(?:!$name_re!$pct_re)*(?:!\s*$name_re)?/;
  # <postfix>  -> |!!<plus>|!![<num>]
  my $postfix_re = qr/!!(?:\++|\[\d+\])/;
  # <expr>         : <prefix><ne_name><mix_expr><postfix>
  my $expr_re = qr/($prefix_re*)($ne_name_re)
                        ($mix_expr_re)?($postfix_re)?/x;    # 4 inner groups
  my $core_model_re = qr/rgb|cmy|cmyk|hsb|gray/;
  # PGF flaw here; don't allow div to be empty
  my $div_re         = qr/[+-]*(?:\d*[1-9]+\d*(?:\.\d*)?|\d*\.\d*[1-9]+\d*)/;
  my $div_capture_re = qr/[+-]*(\d*[1-9]+\d*(\.\d*)?|\d*\.\d*[1-9]+\d*)/;
  my $dec_re         = qr/[+-]*(?:\d*\.?\d*)/;
  # <ext_expr>     : <core_model>,<div>:<expr1><dec1>;...;<exprk><deck>
  #                     | <core_model>:<expr1><dec1>;...;<exprk><deck>
  my $ext_expr_re = qr/($core_model_re)(,($div_re))?:\s*
                       (($expr_re|$name_re),$dec_re(?:;\s*(?:$expr_re|$name_re),$dec_re)*)/x;
  # <color_expr>   : <name> | <expr> | <ext_expt>
  my $color_expr_re = qr/$expr_re|$ext_expr_re/;
  my $function_re   = qr/wheel|twheel/;
  my $arg_re        = $div_re;
  # <func_expr>    : ><function>,<arg1>,...,<argj>
  my $func_expr_re = qr/>$function_re,(?:$arg_re|$arg_re,$arg_re)/;
  # <color>        : <color_expr><func_expr1>...<func_expri>
  my $color_re = qr/($color_expr_re)(($func_expr_re)*)/;

  my $color;
  if ($expression =~ /^$color_re$/) {
    #DG: Dear reader, I present to you: maintenance hell:
    my $prefix     = $2 || $10;
    my $name       = $3 || $11;
    my $mix_expr   = $4 || $12;
    my $postfix    = $5 || $13;
    my $core_model = $6;
    my $div        = $8;
    my $exprs      = $9;
    my $func_expr  = $19;
    my @pallete    = ();

    if (defined $core_model) {    # Extended color expression: combine colors as on a pallete
      $color = Black->convert($core_model);
      my $dectot = 0;
      while ($exprs =~ s/($expr_re),($dec_re)//) {
        my $dec = $6; $dec =~ s/--//g;
        next if !$dec || $dec eq '.';    # the contribution is 0!
        $dectot += $dec;
        push(@pallete, [DecodeColor($1), $dec]); }
      $div = $dectot unless $div;
      foreach my $cp (@pallete) {
        $color = $color->add($$cp[0]->scale($$cp[1] / $div)); } }
    else {    # Standard Color Expression: <prefix><name><mix_expr><postfix>
      $color = ($postfix && ($postfix =~ /!!\[(\d+)\]/)    # Note "out-of-order" effect!
        ? indexColorSeries($name, $1)
        : LookupXColor($name));
      if (my $blend = LookupValue('color_blend')) {        # Combine any stored blend with the mix_expr.
        $mix_expr .= $blend; }
      if ($mix_expr) {
        while ($mix_expr =~ s/^!([^!]*)(!([^!]*))?//x) {
          my ($nm, $pct) = ($3 || 'white', $1);
          $pct =~ s/--//g; $pct = ($pct eq '' ? 100 : ($pct eq '.' ? 0 : $pct));
          $color = $color->mix(LookupXColor($nm), max(0, min(100, $pct)) / 100); } }
      $color = $color->complement if $prefix && (length($prefix) % 2);
      if ($postfix && ($postfix =~ /^!!(\++)$/)) {
        stepColorSeries($name, length($1)); } }    # Step the series, but no effect on color
                                                   # Now apply any function expressions to the result.
    if ($func_expr) {
      while ($func_expr =~ s/>(wheel|twheel),$pct_capture_re(,$div_capture_re)?//) {
        my ($func, $angle, $full) = ($1, $2, $4);
        my $model = ($func eq 'wheel' ? 'Hsb' : 'tHsb');
        my ($h, $s, $b) = $color->convert($model)->components;
        my $circle = ($full ? ToString(Expand(T_CS('\rangeHsb'))) / $full : 1);
        $color = Color($model, $h + $angle * $circle, $s, $b); } }
  }
  else {
    Error('misdefined', $expression, $STATE->getStomach,
      "syntax error in <color> expression '$expression'");
    return Black; }
  return $color; }

sub LookupXColor {
  my ($name) = @_;
  if ($name =~ /^(-*)([^-].*)$/) {
    return (length($1) % 2 ? LookupColor($2)->complement : LookupColor($2)); } }

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Selecting a Color Model.
# But I THINK we're going to end up using pure HTML color model as the TARGET model?
# Is it worth thinking about the "natural" model to store the intermediate colors?

# \selectcolormodel{model}
# Sets the target model to model
DefMacro('\selectcolormodel{}', '');
DefMacro('\XC@tgt@mod {}',      '#1');

# \substitutecolormodel{sourcemodel}{targetmodellist}
# makes xcolor use (one of) target model whenever source model was specified
DefMacro('\substitutecolormodel{}{}', '');

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Defining colors
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

DefMacroI('\xglobal@list', undef,
  '\definecolor\definecolors\definecolorset\colorlet\providecolor'
    . '\providecolors\providecolorset\blendcolors\maskcolors');    #  \substitutecolormodel}

DefMacro('\xglobal Token', sub {
    my ($gullet, $token) = @_;
    if (grep { $token->equals($_) } LookupDefinition(T_CS('\xglobal@list'))->getExpansion->unlist) {
      AssignValue('xglobal@' => 1);
      $token; }
    else {
      (T_CS('\global'), $token); } });

# Internal storage of color definition 5 elements:
#  \\color@<name> => { \xcolor@ {<type>} {<driver_rep>} {<model>} {<spec>}
# [if <type> is 'named', <driver_rep> might be the name?
# Silviu says that the \\color@<name> expanding to some encoding is crucial for pgf->svg.
# He's using the form  {\relax \relax {rgb r g b} {rgb} {r,g,b} }
# Which parts of that are crucial? the internal form?, the spec? all of it?

sub checkNoPostscript {
  my ($type, $macro) = @_;
  $type = ToString($type->isaBox ? $type : Expand($type)) if ref $type;
  if ($type && ($type eq 'ps')) {    # Warn? Ignore postscript
    Info('ignored', $macro, $STATE->getStomach, "Ignoring definition of postscript color in $macro");
    return; }
  return 1; }

# \definecolor[<type>]{<name>}{<model_list>}{<spec_list>}
DefMacro('\definecolor[]{}{}{}', '\XC@definecolor[#1]{#2}[\colornameprefix]{#3}{#4}');
# prepare, same but defered.... but we don't bother defering!
Let('\preparecolor', '\definecolor');
Let('\xdefinecolor', '\definecolor');

# \providecolor[<type>]{<name>}{<model_list>}{<spec_list>}
DefMacro('\providecolor[]{}{}{}', '\XC@providecolor[#1]{#2}[\colornameprefix]{#3}{#4}');

# \DefineNamedColor{<type>}{<name>}{<model_list>}{<spec_list>}
DefMacro('\DefineNamedColor{}{}{}{}', '\definecolor[#1]{#2}{#3}{#4}');

# What is $prefix (\colornameprefix, defaults to XC@  ??? ) used for?
DefMacroI('\colornameprefix', undef, 'XC@');

DefPrimitive('\XC@definecolor[]{}[]{}{}', sub {
    my ($stomach, $type, $name, $prefix, $models, $specs) = @_;
    return unless checkNoPostscript($type, '\XC@definecolor');
    ($type, $name, $prefix, $models, $specs)
      = map { $_ && Expand($_) } $type, $name, $prefix, $models, $specs;
    DefColor(ToString($name), ParseXColor($models, $specs),
      (LookupValue('xglobal@' => 0) ? 'global' : undef));
    AssignValue('xglobal@' => 0);
    # and return a box, so it can be recorded?
    # but we don't want the \XC@ version, and we're not handling the prefix anyway...
    Box(undef, undef, undef,
      Invocation(T_CS('\definecolor'), ($type && $type->unlist ? $type : undef),
        $name, $models, $specs)); });

DefPrimitive('\XC@providecolor[]{}[]{}{}', sub {
    my ($stomach, $type, $name, $prefix, $models, $specs) = @_;
    return unless checkNoPostscript($type, '\XC@providecolor');
    ($type, $name, $prefix, $models, $specs)
      = map { $_ && Expand($_) } $type, $name, $prefix, $models, $specs;
    my $sname = ToString($name);
    return if LookupValue('color_' . $sname);
    DefColor($sname, ParseXColor($models, $specs),
      (LookupValue('xglobal@' => 0) ? 'global' : undef));
    AssignValue('xglobal@' => 0);
    Box(undef, undef, undef,
      #      Invocation(T_CS('\XC@providecolor'),$type,$name,$prefix,$models,$specs)); });
      Invocation(T_CS('\providecolor'), ($type && $type->unlist ? $type : undef),
        $name, $models, $specs)); });

# \colorlet[<type>]{<name>}[<num_model>]{<color>}
DefPrimitive('\colorlet[]{}[]{}', sub {
    my ($stomach, $type, $name, $tomodel, $colordesc) = @_;
    return unless checkNoPostscript($type, '\colorlet');
    ($type, $name, $tomodel, $colordesc)
      = map { $_ && Expand($_) } $type, $name, $tomodel, $colordesc;
    my $color = ParseXColor(undef, $colordesc, $tomodel);
    DefColor(ToString($name), $color, (LookupValue('xglobal@' => 0) ? 'global' : undef));
    AssignValue('xglobal@' => 0);
    Box(undef, undef, undef,
      Invocation(T_CS('\definecolor'), $type, $name,    # Revert to ACTUAL color, not user's name
        T_OTHER('rgb'), T_OTHER(join(',', $color->rgb->components)))); });

# \definecolorset[<type>]{<model_list>}{<head>}{<tail>}{<set_spec>}
DefPrimitive('\definecolorset[]{}{}{}{}', sub {
    my ($stomach, $type, $models, $head, $tail, $specset) = @_;
    return unless checkNoPostscript($type, '\definecolorset');
    ($type, $models, $head, $tail, $specset)
      = map { $_ && Expand($_) } $type, $models, $head, $tail, $specset;
    my $shead = ToString($head);
    my $stail = ToString($tail);
    my $scope = (LookupValue('xglobal@' => 0) ? 'global' : undef);
    foreach my $spec (split(/;/, ToString($specset))) {

      if ($spec =~ /^([^,]*),(.*)$/) {
        my ($name, $specs) = ($1, $2);
        DefColor($shead . $name . $stail, ParseXColor($models, $specs), $scope); } }
    AssignValue('xglobal@' => 0);
    Box(undef, undef, undef,
      Invocation(T_CS('\definecolorset'), $type, $models, $head, $tail, $specset)); });

Let('\preparecolorset', '\definecolorset');

# \providecolorset[<type>]{<model_list>}{<head>}{<tail>}{<set_spec>}
DefPrimitive('\providecolorset[]{}{}{}{}', sub {
    my ($stomach, $type, $models, $head, $tail, $specset) = @_;
    return unless checkNoPostscript($type, '\providecolorset');
    ($type, $models, $head, $tail, $specset)
      = map { $_ && Expand($_) } $type, $models, $head, $tail, $specset;
    my $shead = ToString($head);
    my $stail = ToString($tail);
    my $scope = (LookupValue('xglobal@' => 0) ? 'global' : undef);
    foreach my $spec (split(/;/, ToString(Expand($specset)))) {

      if ($spec =~ /^([^,]*),(.*)$/) {
        my ($name, $specs) = ($1, $2);
        my $defname = $shead . $name . $stail;
        next if LookupValue('color_' . $defname);
        DefColor($defname, ParseXColor($models, $specs), $scope); } }
    AssignValue('xglobal@' => 0);
    Box(undef, undef, undef,
      Invocation(T_CS('\providecolorset'), $type, $models, $head, $tail, $specset)); });

sub defineColors {
  my ($stomach, $idpairs, $ifundef) = @_;
  foreach my $pair (split(/,/, ToString($idpairs))) {
    $pair =~ s/^\s*//; $pair =~ s/\s*$//;
    my ($name, $from) = ($pair =~ /^([^=]*?)\s*=\s*(.*)$/ ? ($1, $2) : ($pair, $pair));
    next if $ifundef && LookupValue('color_' . $name);
    if (my $c = LookupValue('color_' . $from)) {
      AssignValue('color_' . $name => $c);
      DefMacroI('\\\\color@' . $name, undef, Expand(T_CS('\\\\color@' . $from))); } }
  return; }

DefPrimitive('\definecolors{}', sub {
    my $idpairs = Expand($_[1]);
    defineColors($_[0], $idpairs, 0);
    Box(undef, undef, undef, Invocation(T_CS('\definecolors'), $idpairs)); });

DefPrimitive('\providecolors{}', sub {
    my $idpairs = Expand($_[1]);
    defineColors($_[0], $idpairs, 1);
    Box(undef, undef, undef, Invocation(T_CS('\providecolors'), $idpairs)); });

# Now, define the default colors.
RawTeX(<<'EOTeX');
\definecolorset{rgb/hsb/cmyk/gray}{}{}%
 {red,1,0,0/0,1,1/0,1,1,0/.3;%
  green,0,1,0/.33333,1,1/1,0,1,0/.59;%
  blue,0,0,1/.66667,1,1/1,1,0,0/.11;%
  brown,.75,.5,.25/.083333,.66667,.75/0,.25,.5,.25/.5475;%
  lime,.75,1,0/.20833,1,1/.25,0,1,0/.815;%
  orange,1,.5,0/.083333,1,1/0,.5,1,0/.595;%
  pink,1,.75,.75/0,.25,1/0,.25,.25,0/.825;%
  purple,.75,0,.25/.94444,1,.75/0,.75,.5,.25/.2525;%
  teal,0,.5,.5/.5,1,.5/.5,0,0,.5/.35;%
  violet,.5,0,.5/.83333,1,.5/0,.5,0,.5/.205}%
\definecolorset{cmyk/rgb/hsb/gray}{}{}%
 {cyan,1,0,0,0/0,1,1/.5,1,1/.7;%
  magenta,0,1,0,0/1,0,1/.83333,1,1/.41;%
  yellow,0,0,1,0/1,1,0/.16667,1,1/.89;%
  olive,0,0,1,.5/.5,.5,0/.16667,1,.5/.39}
\definecolorset{gray/rgb/hsb/cmyk}{}{}%
 {black,0/0,0,0/0,0,0/0,0,0,1;%
  darkgray,.25/.25,.25,.25/0,0,.25/0,0,0,.75;%
  gray,.5/.5,.5,.5/0,0,.5/0,0,0,.5;%
  lightgray,.75/.75,.75,.75/0,0,.75/0,0,0,.25;%
  white,1/1,1,1/0,0,1/0,0,0,0}
EOTeX

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Using Colors
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

DefPrimitive('\color[]{}', sub {
    my ($stomach, $models, $colororspecs) = @_;
    ($models, $colororspecs) = map { $_ && Expand($_) } $models, $colororspecs;
    my $color = ParseXColor($models, $colororspecs);
    DefColor('.', $color);
    AssignValue('preambleTextcolor', $color) if LookupValue('inPreamble');
    MergeFont(color => $color);
    (Box(undef, undef, undef,
        Invocation(T_CS('\color'), T_OTHER('rgb'),    # Revert to ACTUAL color, not user's name
          T_OTHER(join(',', $color->rgb->components)))),
      $stomach->digest(T_CS('\XC@mcolor'))); });

DefPrimitive('\set@color', sub {
    my $color = LookupValue('color_.');
    AssignValue('preambleTextcolor', $color) if LookupValue('inPreamble');
    MergeFont(color => $color);
    Box(undef, undef, undef, T_CS('\set@color')); });

DefPrimitive('\pagecolor[]{}', sub {
    my ($stomach, $models, $colororspecs) = @_;
    ($models, $colororspecs) = map { $_ && Expand($_) } $models, $colororspecs;
    my $color = ParseXColor($models, $colororspecs);
    AssignValue('preambleBackgroundcolor', $color) if LookupValue('inPreamble');
    MergeFont(background => $color);
    (LookupValue('inPreamble') ? ()
      : Box(undef, undef, undef, Invocation(T_CS('\pagecolor'), $models, $colororspecs))); });

#======================================================================
# Color Boxes
#======================================================================
# These probably work from the previous & color definitions?

# \colorbox{<color>}{<text>}
# \fcolorbox{<color/frame>}{<color/background>}{<text>}
# \fcolorbox[<model_list>]{<spec_list/frame>}{<spec_list/background>}{<text>}
# \fcolorbox[<model_list/frame>]{<spec_list/frame>}[<model_list/background>{<spec_list/background>}{<text>}
# \fcolorbox{<color/frame>}[<model_list/background>{<spec_list/background>}{<text>}

# \boxframe{<width>}{<height>}{<depth}>
#  this should probably derive from the code for \hrule,
#  but arrange for the color to determine the border's color, not the background!

DefConstructor('\boxframe{Dimension}{Dimension}{Dimension}',
  "<ltx:rule width='#1'  height='#2' depth='#3'"
    . " color='#color' framed='rectangle' framecolor='#framecolor'/>",
  afterDigest => sub {
    my ($stomach, $whatsit) = @_;
    my $font = LookupValue('font');
    $whatsit->setProperties(color => $font->getBackground || White,
      framecolor => $font->getColor || Black);
    return; });

#======================================================================
# Blending Colors
#======================================================================
# \blendcolors{<mix_expr>}
# \blendcolors*{<mix_expr>}
DefPrimitive('\blendcolors OptionalMatch:* {}', sub {
    my ($stomach, $star, $mix) = @_;
    # global if \global
    AssignValue(color_blend => (($star && LookupValue('color_blend')) || '') . ToString(Expand($mix)),
      (LookupValue('xglobal@' => 0) ? 'global' : undef));
    AssignValue('xglobal@' => 0); });

DefMacro('\colorblend', sub { Explode(LookupValue('color_blend')); });

# \maskcolors[<num_model>]{<color>}
# Interestingly, this COULD work, but something like this
#      $color = $color->convert($mask->model)->multiply($mask->components);
# needs to be applied just before merging the color into the font.
# And anyway, it seems absurd that someone wants to generate color separated XML?!?!
DefPrimitive('\maskcolors[]{}', sub {
    my ($stomach, $model, $color) = @_;
    Info('ignored', '\maskcolors', $stomach,
      "Ignoring \\maskcolors declaration.");
    return;
    # DefMacroI('\colormask',undef,$color);
    # \maskcolorstrue
    # $color = ToString(Expand($color));
    # if($color){
    #   $color = ParseXColor(undef,$color,$model); }
    # AssignValue(color_mask=>$color);
});

# \colormask
DefMacroI('\colormask', undef, '');

#======================================================================
# Color Series
#======================================================================
# \definecolorseries{<name>}{<core_model>}{<method>}[<b_model>]{<b_spec>}[<s_model>]{<s_spec>}
# <name> becomes a named color, but with provisions to step it through a sequence
DefPrimitive('\definecolorseries{}{}{}[]{}[]{}', sub {
    my ($stomach, $name, $model, $method, $bmodel, $bspec, $smodel, $sspec) = @_;
    ($name, $model, $method, $bmodel, $bspec, $smodel, $sspec) =
      map { $_ && Expand($_) } $name, $model, $method, $bmodel, $bspec, $smodel, $sspec;
    $name  = ToString($name);
    $model = ToString($model);
    my $base = ParseXColor($bmodel, $bspec, $model);
    $method = ToString($method);
    my $grad = (($method eq 'step') || ($method eq 'grad')
      ? Color($model, split(/,/, ToString($sspec)))
      : ParseXColor($smodel, $sspec, $model));
    AssignValue('color_series_' . $name . '_base'   => $base,   'global');
    AssignValue('color_series_' . $name . '_method' => $method, 'global');
    AssignValue('color_series_' . $name . '_delta'  => $grad,   'global');    # gradient or last
});

# \resetcolorseries[<div>]{<name>}
# reset/initialize the color series <name> for <div> steps.
DefPrimitive('\resetcolorseries Optional:\colorseriescycle {}', sub {
    my ($stomach, $div, $name) = @_;
    $name = ToString(Expand($name));
    $div  = ToString(Expand($div));
    my $base   = LookupValue('color_series_' . $name . '_base');
    my $method = LookupValue('color_series_' . $name . '_method');
    my $grad   = LookupValue('color_series_' . $name . '_delta');    # gradient or last
    my $step;
    if    ($method eq 'step') { $step = $grad; }
    elsif ($method eq 'grad') { $step = $grad->scale(1 / $div); }
    elsif ($method eq 'last') {
      my @f = $grad->components;
      my @b = $base->components;
      $step = Color($base->model, map { ($f[$_] - $b[$_]) / $div } 0 .. $#b); }
    DefColor($name, $base, 'global');                                  # Reset <name> to it's base value
    AssignValue('color_series_' . $name . '_step' => $step, 'global'); # and set the current step size
});

# \colorseriescycle   Default number of steps in color series
DefMacro('\colorseriescycle', '16');

# perverse rotation of value back into [0..1], INCLUSIVE!
# accomodating rounding down to 1, up to 0, and fudging for rounding errors...
sub rangeReduction {
  my ($value) = @_;
  return ($value > 1 ? ($value > 1.00001 ? $value - int($value) : 1)
    : ($value < 0 ? ($value < -0.0001 ? ($value - int($value) + 1) : 0)
      : $value)); }

# Step the color series to the next position.
sub stepColorSeries {
  my ($name, $n) = @_;
  my $color = LookupValue('color_' . $name);
  my $step  = LookupValue('color_series_' . $name . '_step');
  my @comp  = $color->components;
  my @step  = $step->components;
  DefColor($name, Color($color->model,
      map { rangeReduction($comp[$_] + $n * $step[$_]) } 0 .. $#comp), 'global');
  return; }

# return the $p-th color in the color series (but don't step it!)
sub indexColorSeries {
  my ($name, $p) = @_;
  my $base = LookupValue('color_series_' . $name . '_base');
  my $step = LookupValue('color_series_' . $name . '_step');
  my @comp = $base->components;
  my @step = $step->components;
  return Color($base->model, map { rangeReduction($comp[$_] + $p * $step[$_]) } 0 .. $#comp); }

#======================================================================
# Table support
#======================================================================
# \rowcolors[<commands>]{<row>}{<color/odd>}{<color/even>}
# \rowcolors*[<commands>]{<row>}{<color/odd>}{<color/even>}
AddToMacro('\@tabular@row@after', '\@xcolor@row@after');
AddToMacro('\@tabular@before',    '\@xcolor@tabular@before');
DefMacroI('\@xcolor@tabular@before', undef, '');
DefMacroI('\@xcolor@row@after',      undef, '');
DefPrimitive('\rowcolors OptionalMatch:* []{Number}{}{}', sub {
    my ($stomach, $star, $commands, $first, $oddcolor, $evencolor) = @_;
    ($oddcolor, $evencolor) = map { $_ && Expand($_) } $oddcolor, $evencolor;
    ## Wishful thinking...?
    DefMacroI('\@xcolor@row@after',      undef, $commands);
    DefMacroI('\@xcolor@tabular@before', undef, $commands);
    AssignValue(tabular_row_color_first => $first->valueOf);
    AssignValue(tabular_row_color_odd   => ($oddcolor->unlist ? ParseXColor(undef, $oddcolor) : undef));
    AssignValue(tabular_row_color_even => ($evencolor->unlist ? ParseXColor(undef, $evencolor) : undef)); });

DefConditional('\if@rowcolors', undef);
RawTeX('\@rowcolorstrue');
#DefMacroI('\showrowcolors', undef, '\global\@rowcolorstrue');
#DefMacroI('\hiderowcolors', undef, '\global\@rowcolorsfalse');
DefMacroI('\showrowcolors', undef, '\hidden@noalign{\global\@rowcolorstrue}');
DefMacroI('\hiderowcolors', undef, '\hidden@noalign{\global\@rowcolorsfalse}');

DefMacro('\rownum', sub {
    my $alignment = LookupValue('Alignment');
    return $alignment ?
      Explode($alignment->currentRowNumber) :
      T_OTHER(0); });

# This doesn't happen early enough to register \hiderowcolors|\showrowcolors in the same row!
AddToMacro('\@tabular@row@before', '\@tabular@row@before@xcolor');
#AddToMacro('\@tabular@row@after','\@tabular@row@after@xcolor');

# Note that this does NOT override columncolor!
# so we do NOT assign to tabular_row_color!!!
# only set the background color & font for the row.
DefConstructor('\@tabular@row@before@xcolor', sub {
    my ($document, %props) = @_;
    if (my $bg = $props{background}) {    # only set if explicitly set a color
      if (my $node = $document->findnode('ancestor-or-self::ltx:tr', $document->getNode)) {
        if (!$node->hasAttribute('backgroundcolor')) {
          $document->setAttribute($node, backgroundcolor => $bg); } } }
    return; },
  afterDigest => sub {
    my ($stomach, $whatsit) = @_;
    if (IfCondition(T_CS('\if@rowcolors'))) {
      my $n     = LookupValue('Alignment')->currentRowNumber;
      my $first = LookupValue('tabular_row_color_first');
      my $odd   = LookupValue('tabular_row_color_odd');
      my $even  = LookupValue('tabular_row_color_even');
      if ((defined $n) && (defined $first) && (defined $odd) && (defined $even)) {
        if ($n >= $first) {
          my $bg = ($n % 2 ? $odd : $even);
          MergeFont(background => $bg);
          $whatsit->setFont(LookupValue('font'));
          $whatsit->setProperty(background => $bg); } } }
    return; },
  reversion  => '',
  properties => { alignmentSkippable => 1 }
);

#======================================================================
# Color Specs
#======================================================================
sub fixedpt {
  my ($value) = @_;
  return int($value * 10000 + 0.5) / 10000; }

# \extractcolorspec{<color>}{<cmd>}
# Decodes <color> and defines
#    \cmd => {{<model>}{<spec>}}
DefPrimitive('\extractcolorspec{}{}', sub {
    my ($stomach, $colordesc, $cmd) = @_;
    my $color = ParseXColor(undef, Expand($colordesc));
    my $model = $color->model;
    my @spec  = ($model eq 'HTML' ? $color->components
      : map { fixedpt($_) } $color->components);
    DefMacroI(ToString($cmd), undef, '{' . $model . '}{' . join(',', @spec) . '}'); });

# \extractcolorspecs{<color>}{<modelcmd>}{<speccmd>}
DefPrimitive('\extractcolorspecs{}{}{}', sub {
    my ($stomach, $colordesc, $modelcmd, $speccmd) = @_;
    my $color = ParseXColor(undef, Expand($colordesc));
    my $model = $color->model;
    my @spec  = ($model eq 'HTML' ? $color->components
      : map { fixedpt($_) } $color->components);
    DefMacroI(ToString($modelcmd), undef, $model);
    DefMacroI(ToString($speccmd),  undef, '{' . join(',', @spec) . '}'); });

# \convertcolorspec{<model>}{<spec>}{<model/target>}{<cmd>}
DefPrimitive('\convertcolorspec{}{}{}{}', sub {
    my ($stomach, $fmodel, $spec, $tomodel, $cmd) = @_;
    ($fmodel, $spec, $tomodel) = map { $_ && Expand($_) } $fmodel, $spec, $tomodel;
    # We expect only one model/spec here, but simplify API
    my $color = ParseXColor($fmodel, $spec, $tomodel);
    my $model = $color->model;
    my @spec  = ($model eq 'HTML' ? $color->components
      : map { fixedpt($_) } $color->components);
    DefMacroI(ToString($cmd), undef, join(',', @spec)); });

#======================================================================
# Arithmetic
#======================================================================
# \rdivide#1#2
# \rmultiply#1#2
# \rshift, \rrshift
# \lshift, \llshift
# (and a bunch more? \\llshift, \lshiftnum...

Let('\rmultiply', '\multiply');
Let('\rdivide',   '\divide');

DefPrimitive('\lshift Variable', sub {
    my ($stomach, $var) = @_;
    return () unless $var;
    my ($defn, @args) = @$var;
    $defn->setValue($defn->valueOf(@args)->multiply(10), @args); });

DefPrimitive('\llshift Variable', sub {
    my ($stomach, $var) = @_;
    return () unless $var;
    my ($defn, @args) = @$var;
    $defn->setValue($defn->valueOf(@args)->multiply(100), @args); });

DefMacro('\lshiftnum {}', sub {
    my ($gullet, $num) = @_;
    Explode(10 * ToString(Expand($num))); });

DefMacro('\llshiftnum {}', sub {
    my ($gullet, $num) = @_;
    Explode(100 * ToString(Expand($num))); });

DefPrimitive('\lshiftset Variable {}', sub {
    my ($stomach, $var, $num) = @_;
    return () unless $var;
    my ($defn, @args) = @$var;
    $defn->setValue((10 * ToString(Expand($num)) . 'pt'), @args); });

DefPrimitive('\llshiftset Variable {}', sub {
    my ($stomach, $var, $num) = @_;
    return () unless $var;
    my ($defn, @args) = @$var;
    $defn->setValue((100 * ToString(Expand($num)) . 'pt'), @args); });

DefPrimitive('\rshift Variable', sub {
    my ($stomach, $var) = @_;
    return () unless $var;
    my ($defn, @args) = @$var;
    $defn->setValue($defn->valueOf(@args)->multiply(0.1), @args); });

DefPrimitive('\rrshift Variable', sub {
    my ($stomach, $var) = @_;
    return () unless $var;
    my ($defn, @args) = @$var;
    $defn->setValue($defn->valueOf(@args)->multiply(0.01), @args); });

#\fcolorbox{name}{text} or \fcolorbox[model]{spec}{text}
DefConstructor('\fcolorbox[]{}{} Undigested',
  "<ltx:text framed='rectangle' framecolor='#framecolor'"
    . " _noautoclose='1'>#text</ltx:text>",
  bounded     => 1, mode => 'text',
  afterDigest => sub {
    my ($stomach, $whatsit) = @_;
    my ($model, $fspec, $bspec, $text) = $whatsit->getArgs;
    $whatsit->setProperty(framecolor => ParseXColor($model, $fspec));
    MergeFont(background => ParseXColor($model, $bspec));
    $whatsit->setProperty(text => Digest($text)); });

#======================================================================
# General TeX internals
#======================================================================
RawTeX(<<'EOTeX');
\let\XC@bcolor\relax
\let\XC@mcolor\relax
\let\XC@ecolor\relax

\def\XC@append#1#2%
{\ifx#1\@undefined\def#1{#2}\else\ifx#1\relax\def#1{#2}\else
  \toks@\expandafter{#1#2}\edef#1{\the\toks@}\fi\fi}
\def\XC@let@cc#1{\expandafter\XC@let@Nc\csname#1\endcsname}
\providecommand*\@namelet[1]{\expandafter\XC@let@Nc\csname#1\endcsname}
\def\XC@let@Nc#1#2{\expandafter\let\expandafter#1\csname#2\endcsname}
\def\XC@let@cN#1{\expandafter\let\csname#1\endcsname}
\def\@namexdef#1{\expandafter\xdef\csname #1\endcsname}
\def\aftergroupdef#1#2%
 {\expandafter\endgroup\expandafter\def\expandafter#1\expandafter{#2}}
\def\aftergroupedef#1#2%
 {\edef\@@tmp{\def\noexpand#1{#2}}\expandafter\endgroup\@@tmp}
\begingroup
\catcode`\!=13 \catcode`\:=13 \catcode`\-=13 \catcode`\+=13
\catcode`\;=13 \catcode`\/=13 \catcode`\"=13 \catcode`\>=13
\gdef\XC@edef#1#2%
 {\begingroup
  \ifnum\catcode`\!=13 \edef!{\string!}\fi
  \ifnum\catcode`\:=13 \edef:{\string:}\fi
  \ifnum\catcode`\-=13 \edef-{\string-}\fi
  \ifnum\catcode`\+=13 \edef+{\string+}\fi
  \ifnum\catcode`\;=13 \edef;{\string;}\fi
  \ifnum\catcode`\"=13 \edef"{\string"}\fi
  \ifnum\catcode`\>=13 \edef>{\string>}\fi
  \edef#1{#2}\@onelevel@sanitize#1\aftergroupdef#1#1}
\gdef\XC@mdef#1#2%
 {\begingroup
  \ifnum\catcode`\/=13 \edef/{\string/}\fi
  \ifnum\catcode`\:=13 \edef:{\string:}\fi
  \edef#1{#2}\@onelevel@sanitize#1\aftergroupdef#1#1}
\endgroup
\def\XC@sdef#1#2{\edef#1{#2}\@onelevel@sanitize#1}
\def\@ifxempty#1{\@@ifxempty#1\@@ifxempty\XC@@}
\def\@@ifxempty#1#2\XC@@
 {\ifx#1\@@ifxempty
  \expandafter\@firstoftwo\else\expandafter\@secondoftwo\fi}

\def\XC@strip@comma#1,#2%
 {\ifx,#2%
    #1\expandafter\remove@to@nnil\else#1 \expandafter\XC@strip@comma\fi
  #2}
{\catcode`Q=3
 \gdef\XC@replace#1#2#3%
  {\begingroup
   \def\XC@repl@ce##1#2##2Q##3%
    {\@ifxempty{##2}{\XC@r@pl@ce##1Q}{\XC@repl@ce##1##3##2Q{##3}}}%
   \def\XC@r@pl@ce##1\@empty Q%
    {\expandafter\endgroup\expandafter\def\expandafter#1\expandafter{##1}}%
   \expandafter\XC@repl@ce\expandafter\@empty #1\@empty#2Q{#3}}
}
% ??
\def\XC@type#1%
 {\expandafter\expandafter\expandafter\XC@typ@
  \csname\string\color@#1\endcsname\@empty\@empty\@empty\XC@@}
\def\XC@typ@#1#2#3#4\XC@@
 {\ifx#1\relax 0\else
    \ifx#1\xcolor@
      \ifx$#2$%
        \ifx$#3$4\else3\fi\@gobbletwo
      \else2\fi\@gobbletwo
    \else1\fi
  \fi}

EOTeX

#======================================================================
# Testing support (ugly)
#======================================================================
# Random TeX coding needed by xcolor

DefMacro('\testcolor', '\@testopt{\@testcolor}{}');    # define here, so texscan sees it!

RawTeX(<<'EOTeX');
\newenvironment*{testcolors}[1][rgb,cmyk,hsb,HTML]%
 {\let\@@nam\@empty\count@\z@
  \@for\@@tmp:=#1\do
    {\advance\count@\@ne
     \XC@sdef\@@tmp{\@@tmp}\edef\@@nam{\@@nam{\@@tmp}}}%
  \edef\@@num{\the\count@}%
  \def\XC@@gt{\textgreater}\def\@@tmp{OT1}%
  \ifx\f@encoding\@@tmp
    \@expandtwoargs\in@{,\f@family,}{,cmtt,pcr,}%
    \ifin@\def\XC@@gt{>}\fi
  \fi
  \def\XC@@xcp@{-1}\ifnum\XC@tracing>1 \def\XC@tracing{1}\fi
  \def\@testcolor[##1]##2%
   {\XC@mdef\@@mod{##1}\XC@edef\@@clr{##2}%
    \ifx\@@mod\@empty
      \let\@@arg\@@clr\XC@replace\@@arg>\XC@@gt\else
      \edef\@@arg{[\@@mod]{\@@clr}}\XC@definecolor[]{*}\@@mod\@@clr
      \def\@@clr{*}\fi
    \XC@append\@@arg{&}\extractcolorspecs\@@clr\@@mod\@@clr
    \@testc@lor}%
  \def\@testc@lor
   {\count@\z@
    \expandafter\@tfor\expandafter\@@tmp\expandafter:\expandafter=\@@nam\do
     {\ifx\@@clr\@empty
        \edef\@@cmd{\noexpand\textbf{\@@tmp}}%
      \else
        \convertcolorspec\@@mod\@@clr\@@tmp\@@cmd
        \edef\@@cmd
         {\noexpand\@testc@l@r{\@@tmp}{\@@cmd}%
          \ifx\@@mod\@@tmp\noexpand\underline\fi
          {\expandafter\XC@strip@comma\@@cmd,,\@nnil}}%
      \fi
      \expandafter\XC@append\expandafter\@@arg\expandafter{\@@cmd}%
      \advance\count@\@ne
      \ifnum\count@=\@@num\XC@append\@@arg{\\}\else\XC@append\@@arg{&}\fi}%
    \@@arg}%
  \def\@testc@l@r##1##2%
   {\fboxsep\z@\fbox{\colorbox[##1]{##2}{\phantom{XX}}} }%
  \tabular{@{}l*{\@@num}{l}@{}}%
  \def\@@arg{\textbf{color}& }\let\@@clr\@empty\@testc@lor}%
 {\endtabular\ignorespacesafterend}
EOTeX

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
ProcessOptions();

1;
